home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / misc / m2pica.lha / M2Picasso / Txt / BlitTest1.mod next >
Encoding:
Text File  |  1994-11-17  |  6.8 KB  |  295 lines
  1. (*******************************************************************************
  2.  : Program.         BlitTest.mod
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : Version.         0.5
  7.  : Date.            16.Aug.1994
  8.  : Copyright.       PD
  9.  : Language.        Modula-2
  10.  : Compiler.        M2Amiga V4.3
  11.  : Contents.        Test des Blitters auf der Picasso (Speed) .
  12. *******************************************************************************)
  13.  
  14. (*$ LargeVars := FALSE*)
  15. (*$StackParms := FALSE*)
  16.  
  17. MODULE BlitTest1 ;
  18.  
  19.  
  20. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,BITSET,SHIFT,ASSEMBLE ;
  21.  
  22. FROM UtilityD     IMPORT tagEnd,tagDone ;
  23.  
  24. FROM Arts         IMPORT Assert ;
  25.  
  26. FROM ExecL        IMPORT Forbid,Permit,AllocMem,FreeMem,CopyMem ;
  27. FROM ExecD        IMPORT MemReqs,MemReqSet ;
  28.  
  29. FROM DosL         IMPORT Delay ;
  30.  
  31. FROM GraphicsL    IMPORT SetRGB4 ;
  32.  
  33. FROM IntuitionD   IMPORT ScreenPtr ;
  34. FROM IntuitionL   IMPORT ScreenToFront ;
  35.  
  36. FROM RandomNumber IMPORT RND ;
  37.  
  38. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
  39.                          LockVillageScreen,UnLockVillageScreen,
  40.                          VillageRectFill,VillageBlitCopy,WaitVillageBlit,
  41.                          VillageModeRequest,VillageSetDisplayBuf,VillageGetBufAddr ;
  42. FROM VilIntuiSupD IMPORT SetPackedPixel,LinePacked,ClearScreen,ClearBuf,
  43.                          VilFillRecord,VilCopyRecord,VilScrCopy,VilScrAnd,
  44.                          VilDstInvert,VilScrPaint,TavisTags,InvalidID ;
  45.  
  46. FROM FileSystem   IMPORT Lookup,File,Close,ReadChar,done,ReadBytes,SetPos ;
  47.  
  48. FROM InOut        IMPORT WriteInt,WriteLn,WriteString,Write,WriteCard,WriteHex ;
  49.  
  50. FROM String       IMPORT Compare ;
  51.  
  52. FROM Break        IMPORT InstallException ;
  53.  
  54. FROM Timer2       IMPORT StartTime,StopTime,TimeVal ;
  55.  
  56. IMPORT R ;
  57.  
  58.  
  59.  
  60. VAR cia[0BFE000H]  : BITSET ;
  61.     Joy1[0DFF00CH] : BITSET ;
  62.  
  63.     time      : TimeVal ;
  64.     tags      : ARRAY [0..40] OF LONGCARD ;
  65.     scr       : ScreenPtr ;
  66.  
  67.     start     : ADDRESS ;
  68.     kugeln    : ARRAY [0..9] OF ADDRESS ;
  69.     copy      : VilCopyRecord ;
  70.  
  71.     mode,x,y,
  72.     i         : LONGCARD ;
  73.  
  74.     ok        : LONGINT ;
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81. PROCEDURE Rechts() : BOOLEAN ;
  82.    BEGIN
  83.       RETURN (1 IN Joy1) ;
  84. END Rechts ;
  85.  
  86. PROCEDURE Links() : BOOLEAN ;
  87.    BEGIN
  88.       RETURN (9 IN Joy1) ;
  89. END Links ;
  90.  
  91. PROCEDURE XOR(a,b : BOOLEAN) : BOOLEAN ;
  92.    BEGIN
  93.       RETURN ((a OR b) AND NOT (a AND b)) ;
  94. END XOR ;
  95.  
  96. PROCEDURE Unten() : BOOLEAN ;
  97.    BEGIN
  98.       RETURN XOR(Rechts(),(0 IN Joy1)) ;
  99. END Unten ;
  100.  
  101. PROCEDURE Oben() : BOOLEAN ;
  102.    BEGIN
  103.       RETURN XOR(Links(),(8 IN Joy1)) ;
  104. END Oben ;
  105.  
  106.  
  107. PROCEDURE WaitMaus(delay : INTEGER) ;
  108. BEGIN
  109.   WHILE (6 IN cia) DO
  110.   END ;
  111.   Delay(delay) ;
  112. END WaitMaus ;
  113.  
  114.  
  115. PROCEDURE Erg(elap : TimeVal) ;
  116.   BEGIN
  117.     WriteLn ;
  118.     WriteString("Ergebnis : ") ;
  119.     WriteInt(elap.secs,6) ;
  120.     WriteInt(elap.micro,10) ;
  121.     WriteLn ;
  122.   END Erg ;
  123.  
  124.  
  125. (* Liest BMP in einen Speicherbereich *)
  126. PROCEDURE ReadBMP(name : ARRAY OF CHAR ; w,h : LONGCARD) : ADDRESS ;
  127. VAR f      : File ;
  128.     act,i,
  129.     y      : LONGINT ;
  130.     start,
  131.     cnt    : ADDRESS ;
  132.  
  133.   BEGIN
  134.     start := AllocMem(w*h,MemReqSet{fast}) ;
  135.     Assert(start#NIL,ADR("Kein Speicher !")) ;
  136.  
  137.     Lookup(f,name,40000,FALSE) ;
  138.     Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;
  139.  
  140. (* Warum stehen BMP-Bilder auf dem Kopf ?
  141.     SetPos(f,1078) ;
  142.     ReadBytes(f,start,w*h,act) ;
  143.     IF (act<LONGINT(w*h)) THEN
  144.       Close(f) ;
  145.       Assert(FALSE,ADR("Fehler beim Bildlesen (w*h?) !")) ;
  146.     END ;
  147. *)
  148.     cnt := start ;
  149.     SetPos(f,1078) ;
  150.     INC(cnt,w*(h-1)) ;
  151.     FOR y:=1 TO h DO
  152.       ReadBytes(f,cnt,w,act) ;
  153.       DEC(cnt,w) ;
  154.     END ;
  155.  
  156.     Close(f) ;
  157.     RETURN(start) ;
  158.  
  159.   END ReadBMP ;
  160.  
  161. (* Extrahiert die Palette eines BMP *)
  162. PROCEDURE ReadPAL(name : ARRAY OF CHAR ; scr : ScreenPtr) ;
  163. VAR f      : File ;
  164.     act,i,
  165.     col    : LONGINT ;
  166.     r,g,b,
  167.     s      : SHORTCARD ;
  168.  
  169.   BEGIN
  170.     Lookup(f,name,10000,FALSE) ;
  171.     Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;
  172.  
  173.     SetPos(f,54) ;
  174.     FOR col:=0 TO 255 DO
  175.       ReadBytes(f,ADR(b),1,act) ;
  176.       ReadBytes(f,ADR(g),1,act) ;
  177.       ReadBytes(f,ADR(r),1,act) ;
  178.       ReadBytes(f,ADR(s),1,act) ;
  179.       SetRGB4(ADR(scr^.viewPort),col,r,g,b) ;
  180.     END ;
  181.  
  182.     Close(f) ;
  183.   END ReadPAL ;
  184.  
  185.  
  186.  
  187. PROCEDURE CPUCopy(scr : ScreenPtr ; source : ADDRESS ;
  188.                                     dest   : ADDRESS ;
  189.                                     w,h,xd,yd : LONGINT) ;
  190. VAR x,y,sw   : LONGINT ;
  191.     dst{R.A1},
  192.     srt{R.A0}  : ADDRESS ;
  193.  
  194.   BEGIN
  195.     sw := scr^.width ;
  196.     INC(dest,xd) ;
  197.     INC(dest,sw*yd) ;
  198.     WaitVillageBlit ;
  199.     FOR y:=1 TO h DO
  200.       FOR x:=1 TO w DO
  201.           dest^ := source^ ;
  202.         INC(dest,1) ;
  203.         INC(source,1) ;
  204.       END ;
  205.       INC(dest,sw-w) ;
  206.     END ;
  207.  
  208.   END CPUCopy ;
  209.  
  210.  
  211.  
  212. BEGIN
  213.   InstallException ;
  214.  
  215. (*
  216.   mode := VillageModeRequest(TAG(tags,tavisMinDepth,    8,
  217.                                       tavisMaxDepth,    8,
  218.                                       tavisMinHeight, 256,
  219.                                            tagDone)) ;
  220.   Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;
  221. *)
  222.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenWidth,  640,
  223.                                            tavisScreenHeight, 512,
  224.                                            tavisScreenDepth,    8,
  225.                                            tagDone)) ;
  226.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  227.  
  228.   start := LockVillageScreen(scr) ;
  229.  
  230.   ReadPAL("sq0:pics/sequenz/auto.0001",scr) ;
  231.  
  232.   kugeln[0] := ReadBMP("pics/sequenz/auto.0001",84,67) ;
  233.   kugeln[1] := ReadBMP("pics/sequenz/auto.0002",84,67) ;
  234.   kugeln[2] := ReadBMP("pics/sequenz/auto.0003",84,67) ;
  235.   kugeln[3] := ReadBMP("pics/sequenz/auto.0004",84,67) ;
  236.   kugeln[4] := ReadBMP("pics/sequenz/auto.0005",84,67) ;
  237.   kugeln[5] := ReadBMP("pics/sequenz/auto.0006",84,67) ;
  238.   kugeln[6] := ReadBMP("pics/sequenz/auto.0007",84,67) ;
  239.   kugeln[7] := ReadBMP("pics/sequenz/auto.0008",84,67) ;
  240.   kugeln[8] := ReadBMP("pics/sequenz/auto.0009",84,67) ;
  241.   kugeln[9] := ReadBMP("pics/sequenz/auto.0010",84,67) ;
  242.  
  243.   Forbid() ;
  244.    ScreenToFront(scr) ;
  245.    start := LockVillageScreen(scr) ;
  246.   Permit() ;
  247.  
  248.       copy.scrPitch := 84 ;
  249.       copy.dstPitch := scr^.width ;
  250.       copy.width    := 84 ;
  251.       copy.height   := 67 ;
  252.       copy.rop      := VilScrCopy ;
  253.  
  254.   Forbid() ;
  255.   StartTime() ;
  256.   FOR x:=0 TO 200 DO
  257.  
  258.   copy.scrAdr   := kugeln[x MOD 10] ;
  259.   copy.dstAdr   := start ;
  260.  
  261.   WaitVillageBlit ;
  262.   ok := VillageBlitCopy(scr,ADR(copy)) ;
  263.  
  264.   END ;
  265.   StopTime(time) ;
  266.   Permit() ;
  267.   Erg(time) ;
  268.  
  269.  
  270.   Forbid() ;
  271.   StartTime() ;
  272.   FOR x:=0 TO 200 DO
  273.     CPUCopy(scr,kugeln[x MOD 10],
  274.                 start,
  275.                 84,67,0,0) ;
  276.   END ;
  277.   StopTime(time) ;
  278.   Permit() ;
  279.   Erg(time) ;
  280.  
  281.  
  282.  
  283. CLOSE
  284.   IF scr#NIL THEN
  285.     UnLockVillageScreen(scr) ;
  286.     CloseVillageScreen(scr) ;
  287.   END ;
  288.   FOR i:=0 TO 9 DO
  289.     IF kugeln[i]#NIL THEN
  290.       FreeMem(kugeln[i],84*67) ;
  291.     END ;
  292.   END ;
  293.  
  294. END BlitTest1.
  295.